home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
kmouse10.arc
/
KMOUSE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-04-28
|
11KB
|
283 lines
{ KMouse.Pas }
{ Copyright 1989 by Kenneth A. Hill, P.E. }
{ }
{ }
{ KeyMouse implements a mouse handler that is transparent to the application }
{ Once initialized the mouse handler stuffs the selected keystrokes into }
{ the keyboard buffer where the application reads them. }
Unit KMouse;
InterFace
Const
HasMouse : Boolean = False;
{ Set to True if mouse found during initialization }
MouseVerified : Boolean = False;
{ Set to True if the mouse reset function finds the mouse }
GoodMouse : Boolean = False;
{ Set to True if Mouse driver is Ver. 6 or higher }
{Mouse Motion Masks}
MoveRight = $01;
MoveLeft = $02;
MoveDown = $04;
MoveUp = $08;
MoveAll = $0F;
{ The default is MoveAll }
{Mouse Report masks}
MouseMoved = $01;
MouseLBPressed = $02;
MouseLBReleased = $04;
MouseRBPressed = $08;
MouseRBReleased = $10;
MouseMBPressed = $20;
MouseMBReleased = $40;
{ The default is MouseMoved }
Procedure ResetMouse;
{Performs hardware reset on the mouse, sets Mouse verified}
Procedure InitMouse(Mask:Word);
{ InitMouse installs the mouse handler to the mouse. It must be called }
{ during program initialization, although additional calls are harmless }
{ and may be used to change the interrupt mask. }
{ Mask is the mask passed to the mouse driver to define the Mouse }
{ actions to report on. This Word is bit encoded as follows: }
{ }
{ 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 }
{ 0 0 0 0 0 0 0 0 0 x x x x x x x }
{ ------------------------- ^ ^ ^ ^ ^ ^ ^ }
{ ^ | | | | | | Mouse motion }
{ | | | | | | Left button pressed }
{ | | | | | Left button released }
{ | | | | Right button pressed }
{ | | | Right button released }
{ | | Mid Button pressed }
{ | Mid button released }
{ Reserved, must be 0 }
{ If the bit is set (ie, 1) the mouse calls the user installed handler }
{ when the event occurs. }
{ Utilizing the constants above for the Mask, the call }
{ InitMouse(MouseMoved+MouseLBReleased+MouseRBReleased); }
{ installs the handler and sets the mouse for motion, and L & R button }
{ releases. }
Procedure SetMouseMotion(Direction : Byte);
{ Sets the movement directions the mouse will report on. }
{ Using the the definitions of the constants above, following the call }
{ SetMouseMotion(MoveUp+MoveDown), the mouse will report vertical motion}
{ Correspondingly, SetMouseMotion(MoveAll); establishes vertical and }
{ horizontal mouse motion. The default is MoveAll. Use this procedure }
{ to toggle mouse response from a vertical to a horizonal menu or a }
{ full screen application. }
Procedure SetMouseButtons( LB,RB,MB : Word );
{ Causes the mouse buttons to return the specified scancodes. }
{ Should be called before first initialization, may be called anytime }
{ after to change the buttons returned scancodes. Each button enabled }
{ by the call mask must be > 0 }
Procedure SetMouseDelay( VDelay, HDelay : Word);
{ Sets the delay count for vertical and horizontal mouse movements. The }
{ delay is read and decremented by the mouse driver and only actuated }
{ when the delay counter reaches 0. Use this Procedure to change the }
{ mouse sensitivity for menus, etc. The default is VDelay = 3, HDelay =1}
Procedure SaveMouse;
{ Saves the mouse state if the mouse driver is ver. 6.0 or higher. }
Procedure RestoreMouse;
{ Restores a previously saved mouse state if the mouse driver is Ver. 6.0 }
{ or higher. }
{ The initialization code saves the current mouse in a separate buffer and }
{ restores it during the exit process. }
{ The save/restore mouse procs may be used by a TP application before and }
{ after spawning a child process, eg. in a menuing program. }
{ These procedures require that GoodMouse be true, ie. the mouse driver }
{ must be ver 6.0 or higher. }
(*****************************************************************************)
Implementation
Uses Dos; {For system calls}
Const
MouseInt = $33;
{ Key and control definition defaults }
RKey : Word = $4D00; { Right Cursor Key Scancode }
LKey : Word = $4B00; { Left Cursor Key Scancode }
DKey : Word = $5000; { Down Cursor Key Scancode }
UKey : Word = $4800; { Up Cursor Key Scancode }
LBKey : Word = $0000; { Left Button Key Scancode }
RBKey : Word = $0000; { Right Button Key Scancode }
MBKey : Word = $0000; { Middle Button Key Scancode}
VDly : Word = $0003; { Vertical Delay }
HDly : Word = $0001; { Horizontal Delay }
Msk : Word = MouseMoved; {Set Motion only }
VCount : Word = $0003; { Current Vertical delay count }
HCount : Word = $0001; { Current Horizontal delay count }
MouseMotion : Byte = MoveAll; { Set motion to report UDRL }
Type
VecPtr = ^Byte;
Var
Regs : Registers; { Pseudo registers for mouse calls }
MouseSize : Word; { Size required by mouse buffer }
OldMouseState,
OurMouseState : Array [0..511] of Byte; { Storage buffers for mouse states}
NextExit : Pointer; { Exit pointer }
MouseVec : Pointer; {Mouse Interrupt Vector}
MousePtr : VecPtr ABSOLUTE $0000:$00CC; {mouse vector address}
{$F+}
{$L KeyMous}
Procedure MousKey; External;
{ The mouse event processor }
Procedure ResetMouse;
Begin
Regs.AX := 0; {Function 0 Reset the mouse}
Intr(MouseInt,Regs);
MouseVerified := Regs.AX <> 0;
{If Regs.AX <> 0 Then MouseVerified := True else MouseVerified := false;}
End;
Procedure SetMouseMotion(Direction : Byte);
Begin
MouseMotion := Direction;
End;
Procedure SetMouseButtons( LB,RB,MB : Word );
Begin
LBKey := LB;
RBKey := RB;
MBKey := MB;
End;
Procedure SetMouseDelay( VDelay, HDelay : Word);
Begin
If VDelay > 0 Then
Begin
VDly := VDelay;
VCount := VDelay;
End;
If HDelay > 0 Then
Begin
HDly := HDelay;
HCount := HDelay;
End;
End;
Procedure InitMouse(Mask:Word);
Begin
Msk := Mask;
If MouseVerified {HasMouse} Then { Install Driver }
Begin
Regs.AX := 12;
Regs.CX := Msk;
Regs.DX := Ofs(MousKey);
Regs.ES := Seg(MousKey);
Intr(MouseInt,Regs);
End;
End; {InitMouse}
Procedure SaveMouse;
{ Saves the mouse state }
Begin
If MouseVerified {HasMouse} Then
If GoodMouse Then
If MouseSize < SizeOf(OurMouseState) Then
Begin
Regs.AX := $16;
Regs.DX := Ofs(OurMouseState);
Regs.ES := Seg(OurMouseState);
Intr(MouseInt,Regs);
End
Else WriteLn('Insufficient Buffer size to save mouse.');
End;
Procedure RestoreMouse;
{ Restores a previously saved mouse state }
Begin
If MouseVerified {HasMouse} Then
If GoodMouse Then
If MouseSize < SizeOf(OurMouseState) Then
Begin
Regs.AX := $17;
Regs.DX := Ofs(OurMouseState);
Regs.ES := Seg(OurMouseState);
Intr(MouseInt,Regs);
End
Else WriteLn('Cannot restore Mouse. Insufficient buffer');
End;
Procedure MouseExit;
{ This is the program exit Processor }
Begin
If MouseVerified {HasMouse} Then
Begin
ResetMouse; {Clear the current mouse}
If GoodMouse and (MouseSize < SizeOf(OldMouseState)) Then
Begin
Regs.AX := $17; {Restore driver state}
Regs.DX := Ofs(OldMouseState);
Regs.ES := Seg(OldMouseState);
Intr(MouseInt,Regs);
End;
End;
ExitProc := NextExit;
End;
Procedure SaveOldMouse;
{ Saves the mouse state during program initialization }
Begin
If MouseVerified {HasMouse} Then
If GoodMouse Then
If MouseSize < SizeOf(OldMouseState) Then
Begin
Regs.AX := $16;
Regs.DX := Ofs(OldMouseState);
Regs.ES := Seg(OldMouseState);
Intr(MouseInt,Regs);
End;
End;
Begin { Mouse initialization }
{ First check to see if the mouse interrupt vector points to an IRET }
{ or is NIL }
GetIntVec(MouseInt,MouseVec);
If (MouseVec = Nil) or (MousePtr^ = $CF) { $CF is an IRET}
Then
HasMouse := False
Else
Begin
HasMouse := True; { lets us know we have a mouse }
Regs.AX := $24; { Check mouse Version }
Regs.BX := $FFFF; { Set BX to a known state }
Intr(MouseInt,Regs); { Call mouse }
If (Regs.BX <> $FFFF) and (Regs.BH >= 6) Then
Begin
GoodMouse := True; { Ver 6 Driver allows saving mouse state}
Regs.AX := $15; { get its size }
Intr(MouseInt,Regs);
MouseSize := Regs.BX;
SaveOldMouse; { save its state }
End
Else GoodMouse := False;
ResetMouse; { Clear the old mouse }
NextExit := ExitProc; { Save old Exit Proc }
ExitProc := @MouseExit; { Establish our exit link }
End;
End. {KMouse.Pas}